home *** CD-ROM | disk | FTP | other *** search
/ Suzy B Software 2 / Suzy B Software CD-ROM 2 (1994).iso / picmanip / pic_r2z / raypics3 / rayview2.gfa (.txt) < prev    next >
GFA-BASIC Atari  |  1995-05-05  |  4KB  |  94 lines

  1. ' This program and the file SHOW512.OBJ are Public Domain
  2. ' Use this routine in your GFA-BASIC 2.x/3.x programs to show
  3. ' uncompressed GFA-RAYTRACE 512-Color pictures.
  4. '
  5. ' 12/18/91  I modified this code to load more than just 'DEMO.SUL' as
  6. ' it was in its original crippled state on the Raytrace V2.1 disks. Still
  7. ' doesn't handle compressed pics though...  Also via the file selector,
  8. ' it can be forced to load any file on disk (How indiscriminate!) - I'm
  9. ' too inept to figure out how to prevent that.  It does present a *.SUL
  10. ' filemask, but editing it and loading something else may be disastrous!
  11. '
  12. ' 12/23/91 v1  TT/16mhz Alert added, Palette is now properly restored.
  13. '              SHOW512.OBJ name changed to RAYVIEW.OBJ
  14. '
  15. ' 12/29/91 v2  Removed A: drive letter from file selector, Rayview now
  16. '              defaults to drive it was run from for next pic.
  17. '
  18. ' I be interested in any modifications anyone attempts.  A full-blown
  19. ' slideshow program is needed.  And I still have hopes for a Raytrace to
  20. ' Spectrum/GIF converter...  Nick S. Smith 4406 5th Av S Minneapolis
  21. ' GEnie: S.Smith65    Compuserve: 70412,2667             MN   55409
  22. '
  23. ' .SUL pictures can be created from within GFA Raytrace by using the save
  24. ' screen option when Uncompressed is selected in the STATUS menu.
  25. '
  26. ALERT 3,"Rayview Does Not|Run On A TT/030.|Mega STE's Must|Be Set To 8mhz!",2,"QUIT|VIEW",x#
  27. IF x#=1
  28.   END
  29. ELSE IF x#=2
  30.   RESERVE FRE(0)-21000        ! reserve memory for routines & palettes
  31.   base%=EXEC(3,"rayview.obj","","")     ! load routines
  32.   IF base% AND 1
  33.     ERROR base%
  34.   ENDIF            ! continue only if routines loaded
  35.   @savepal
  36.   @initray         ! initialize routines and Palette-table
  37. entrypoint:
  38.   @loadray         ! load 512-colors picture
  39.   CALL init%       ! Mode ON
  40.   VOID INP(2)      ! Wait for a keypress...
  41.   CALL exit%       ! Mode OFF
  42.   SETCOLOR 0,&H777 ! now restore colors
  43.   SETCOLOR 3,0
  44.   CLS              ! And clear that screen!
  45.   ALERT 2,"|View another |Raytrace pic?",2,"YES|QUIT",button#
  46.   IF button#=1              ! If yes, then let's
  47.     GOTO entrypoint        ! start at the beginning (eeek! a GOTO!)
  48.   ELSE                     ! Otherwise,
  49.     @terminate             ! Don't forget to clean up
  50.   ENDIF
  51. ENDIF                    ! the mess before you leave!
  52. END                      ! P.S.  Say 'Bye-bye'
  53. '
  54. PROCEDURE savepal
  55.   DIM i$(20),palette%(20)
  56.   FOR i%=0 TO 15
  57.     palette%(i%)=XBIOS(7,W:i%,W:-1)
  58.   NEXT i%
  59. RETURN
  60. '
  61. PROCEDURE loadray
  62.   RESERVE FRE(0)-32000         ! Fileselectors need room to work in
  63.   FILESELECT #"Choose a Raytrace Pic","*.SUL","",name$
  64.   IF RIGHT$(name$)="\"         ! Did bozo select a file?
  65.     ALERT 1,"|Please Choose a | GFA  Raytrace |*.SUL Pic File.",1,"OK",dummy#
  66.     @loadray                   ! If so, load it
  67.   ELSE IF name$=""             ! If CANCEL, terminate
  68.     @terminate
  69.   ENDIF
  70.   OPEN "i",#1,name$            ! open file
  71.   SEEK #1,8                    ! skip file-type (used by GFA RAYTRACE)
  72.   BGET #1,XBIOS(3),32000       ! load screen
  73.   BGET #1,palbuf%,18400        ! load palettes in buffer
  74.   CLOSE #1
  75. RETURN
  76. '
  77. PROCEDURE initray
  78.   ADD base%,256
  79.   palbuf%=base%+3000           ! palettes behind routines (see Reserve)
  80.   LPOKE base%,palbuf%          ! start palette-buffer
  81.   init%=LPEEK(base%+4)         ! 512-colors On - routine
  82.   exit%=LPEEK(base%+8)         ! 512-colors Off - routine
  83. RETURN
  84. '
  85. PROCEDURE terminate            ! Restores palette & memory
  86.   FOR i%=0 TO 15
  87.     SETCOLOR i%,palette%(i%)
  88.   NEXT i%
  89.   VOID GEMDOS(73,L:HIMEM)      ! Or when QUIT was selected
  90.   SUB base%,256                ! Was selected in the alert box
  91.   VOID GEMDOS(73,L:base%)
  92.   END
  93. RETURN
  94.